home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Library-2.01 / Interfaces / MEMORY.lisp < prev    next >
Encoding:
Text File  |  1993-09-16  |  12.8 KB  |  472 lines  |  [TEXT/CCL2]
  1.  
  2. (in-package :traps)             ; 
  3. ; Created: Sunday, January 6, 1991 at 10:47 PM
  4. ;     Memory.p
  5. ;     Pascal Interface to the Macintosh Libraries
  6. ; 
  7. ;         Copyright Apple Computer, Inc.    1985-1990
  8. ;         All rights reserved
  9. ; 
  10.  
  11. ;;;;;;;;;;;;;
  12. ;
  13. ; Modification History
  14. ;
  15. ; 04/28/93 mwp Release
  16. ; 08/10/92 bill typo in _HLockHi
  17. ;               Package prefix for ccl::%ptr-to-int in _deferuserfn
  18. ; ------------- 2.0
  19. ; 02/18/92 gb's fix to _GetPhysical
  20. ;               _MaxMem now works as advertised in Inside Macintosh
  21. ; ------------- 2.0f2
  22. ; 08/23/91 bill _PageFaultFatal had a bogus arg in its call form
  23. ;               Fix _StripAddress, _SystemZone, _ApplicZone,
  24. ;               _ApplicationZone, _TopMem
  25. ;
  26.  
  27. ; $IFC UNDEFINED UsingIncludes
  28. ; $SETC UsingIncludes := 0
  29. ; $ENDC
  30.  
  31. ; $IFC NOT UsingIncludes
  32.  
  33. ; $ENDC
  34.  
  35. ; $IFC UNDEFINED UsingMemory
  36. ; $SETC UsingMemory := 1
  37.  
  38. ; $I+
  39. ; $SETC MemoryIncludes := UsingIncludes
  40. ; $SETC UsingIncludes := 1
  41. ; $IFC UNDEFINED UsingTypes
  42.  
  43. (require-interface 'TYPES)      ; $I $$Shell(PInterfaces)Types.p
  44. ; $ENDC
  45. ; $SETC UsingIncludes := MemoryIncludes
  46.  
  47. (defconstant $maxSize #x800000) ; Max data block size is 8 megabytes
  48. (defconstant $defaultPhysicalEntryCount 8)
  49.  
  50. ;  values returned from the GetPageState function 
  51. (defconstant $kPageInMemory 0)
  52. (defconstant $kPageOnDisk 1)
  53. (defconstant $kNotPaged 2)
  54.  
  55. (def-mactype :size (find-mactype :signed-long));  size of a block in bytes 
  56.  
  57. (def-mactype :thz (find-mactype :pointer))
  58. (defrecord Zone 
  59.    (bkLim :pointer)
  60.    (purgePtr :pointer)
  61.    (hFstFree :pointer)
  62.    (zcbFree :signed-long)
  63.    (gzProc :pointer)
  64.    (moreMast :signed-integer)
  65.    (flags :signed-integer)
  66.    (cntRel :signed-integer)
  67.    (maxRel :signed-integer)
  68.    (cntNRel :signed-integer)
  69.    (maxNRel :signed-integer)
  70.    (cntEmpty :signed-integer)
  71.    (cntHandles :signed-integer)
  72.    (minCBFree :signed-long)
  73.    (purgeProc :pointer)
  74.    (sparePtr :pointer)
  75.    (allocPtr :pointer)
  76.    (heapData :signed-integer)
  77.    )
  78.  
  79. (defrecord MemoryBlock 
  80.    (address :pointer)
  81.    (count :signed-long)
  82.    )
  83.  
  84. (defrecord LogicalToPhysicalTable 
  85.    (logical :memoryblock)
  86.    (physical (:array :memoryblock 8))
  87.    )
  88.  
  89. (def-mactype :pagestate (find-mactype :signed-integer))
  90. (def-mactype :statusregistercontents (find-mactype :signed-integer))
  91.  
  92.  
  93. (deftrap _getappllimit nil
  94.    (:no-trap :pointer)
  95.    (:no-trap (%get-signed-long (%int-to-ptr 304))))
  96.  
  97. (deftrap _getzone nil
  98.    (:a0 (:pointer :zone))
  99.    (:stack-trap #xA11A))
  100.  
  101. (deftrap _systemzone nil
  102.    (:no-trap (:pointer :zone))
  103.    (:no-trap (%get-ptr (%int-to-ptr 678))))
  104.  
  105. (deftrap _appliczone nil
  106.    (:no-trap (:pointer :zone))
  107.    (:no-trap (%get-ptr (%int-to-ptr 682))))
  108.  
  109. (deftrap _applicationzone nil
  110.    (:no-trap (:pointer :zone))
  111.    (:no-trap (%get-ptr (%int-to-ptr 682))))
  112.  
  113. (deftrap _newhandle ((bytecount :signed-long))
  114.    (:a0 :handle)
  115.    (:register-trap #xA122 :d0 bytecount))
  116.  
  117. (deftrap _handlezone ((h :handle))
  118.    (:a0 (:pointer :zone))
  119.    (:register-trap #xA126 :a0 h))
  120.  
  121. (deftrap _recoverhandle ((p :pointer))
  122.    (:a0 :handle)
  123.    (:register-trap #xA128 :a0 p))
  124.  
  125. (deftrap _newptr ((bytecount :signed-long))
  126.    (:a0 :pointer)
  127.    (:register-trap #xA11E :d0 bytecount))
  128.  
  129. (deftrap _ptrzone ((p :pointer))
  130.    (:a0 (:pointer :zone))
  131.    (:register-trap #xA148 :a0 p))
  132.  
  133. (deftrap _gzsavehnd nil
  134.    (:no-trap :handle)
  135.    (:no-trap (%get-signed-long (%int-to-ptr 808))))
  136.  
  137. (deftrap _topmem nil
  138.    (:no-trap :pointer)
  139.    (:no-trap (%get-ptr (%int-to-ptr 264))))
  140.  
  141. (deftrap _maxblock nil
  142.    (:d0 :signed-long)
  143.    (:register-trap #xA061))
  144.  
  145. (deftrap _stackspace nil
  146.    (:d0 :signed-long)
  147.    (:register-trap #xA065))
  148.  
  149. (deftrap _newemptyhandle nil
  150.    (:a0 :handle)
  151.    (:register-trap #xA166))
  152.  
  153. (deftrap _hlock ((h :handle))
  154.    nil
  155.    (:register-trap #xA029 :a0 h))
  156.  
  157. (deftrap _hunlock ((h :handle))
  158.    nil
  159.    (:register-trap #xA02A :a0 h))
  160.  
  161. (deftrap _hpurge ((h :handle))
  162.    nil
  163.    (:register-trap #xA049 :a0 h))
  164.  
  165. (deftrap _hnopurge ((h :handle))
  166.    nil
  167.    (:register-trap #xA04A :a0 h))
  168.  
  169. (deftrap _hlockhi ((h :handle))
  170.    nil
  171.    (:no-trap (ccl:register-trap #xA029 :a0 (ccl:register-trap #xA064 :a0 h))))
  172.  
  173. (deftrap _stripaddress ((theaddress :pointer))
  174.    (:d0 :long)
  175.   (ccl:%int-to-ptr (:register-trap #xA055 :d0 (ccl:%ptr-to-int theaddress))))
  176. ; $ENDC
  177.  
  178. (deftrap _translate24to32 ((addr24 :pointer))
  179.    (:d0 :pointer)
  180.    (:register-trap #xA091 :d0 addr24))
  181.  
  182. (deftrap _tempnewhandle ((logicalsize :signed-long) (resultcode (:pointer :signed-integer)))
  183.    (:stack :handle)
  184.    (:stack-trap #xA88F logicalsize resultcode (29 :signed-integer)))
  185.  
  186. (deftrap _tempmaxmem ((grow (:pointer :signed-long)))
  187.    (:stack :signed-long)
  188.    (:stack-trap #xA88F grow (21 :signed-integer)))
  189.  
  190. (deftrap _tempfreemem nil
  191.    (:stack :signed-long)
  192.    (:stack-trap #xA88F (24 :signed-integer)))
  193.  
  194. ;   Temporary Memory routines renamed, but obsolete, in System 7.0 and later.  
  195.  
  196. (deftrap _temphlock ((h :handle) (resultcode (:pointer :signed-integer)))
  197.    nil
  198.    (:stack-trap #xA88F h resultcode (30 :signed-integer)))
  199.  
  200. (deftrap _temphunlock ((h :handle) (resultcode (:pointer :signed-integer)))
  201.    nil
  202.    (:stack-trap #xA88F h resultcode (31 :signed-integer)))
  203.  
  204. (deftrap _tempdisposehandle ((h :handle) (resultcode (:pointer :signed-integer)))
  205.    nil
  206.    (:stack-trap #xA88F h resultcode (32 :signed-integer)))
  207.  
  208. (deftrap _temptopmem nil
  209.    (:stack :pointer)
  210.    (:stack-trap #xA88F (22 :signed-integer)))
  211.  
  212. ;   Temporary Memory routines as they were known before System 7.0.  
  213.  
  214. (deftrap _mfmaxmem ((grow (:pointer :signed-long)))
  215.    (:stack :signed-long)
  216.    (:stack-trap #xA88F grow (21 :signed-integer)))
  217.  
  218. (deftrap _mffreemem nil
  219.    (:stack :signed-long)
  220.    (:stack-trap #xA88F (24 :signed-integer)))
  221.  
  222. (deftrap _mftempnewhandle ((logicalsize :signed-long) (resultcode (:pointer :signed-integer)))
  223.    (:stack :handle)
  224.    (:stack-trap #xA88F logicalsize resultcode (29 :signed-integer)))
  225.  
  226. (deftrap _mftemphlock ((h :handle) (resultcode (:pointer :signed-integer)))
  227.    nil
  228.    (:stack-trap #xA88F h resultcode (30 :signed-integer)))
  229.  
  230. (deftrap _mftemphunlock ((h :handle) (resultcode (:pointer :signed-integer)))
  231.    nil
  232.    (:stack-trap #xA88F h resultcode (31 :signed-integer)))
  233.  
  234. (deftrap _mftempdisposhandle ((h :handle) (resultcode (:pointer :signed-integer)))
  235.    nil
  236.    (:stack-trap #xA88F h resultcode (32 :signed-integer)))
  237.  
  238. (deftrap _mftopmem nil
  239.    (:stack :pointer)
  240.    (:stack-trap #xA88F (22 :signed-integer)))
  241.  
  242. (deftrap _initapplzone nil
  243.    nil
  244.    (:stack-trap #xA02C))
  245.  
  246. (deftrap _initzone ((pgrowzone :pointer) (cmoremasters :signed-integer) (limitptr :pointer) (startptr :pointer))
  247.   (:no-trap :signed-integer)
  248.   (:no-trap (ccl:%stack-block ((p 14))
  249.                (%put-ptr p startptr 0)
  250.                (%put-ptr p limitptr 4)
  251.                (%put-word p cmoremasters 8)
  252.                (%put-ptr p pgrowzone 10)
  253.                (ccl:register-trap #xA019 :a0 p (:signed-integer :d0)))))
  254.  
  255. (deftrap _setzone ((hz (:pointer :zone)))
  256.    nil
  257.    (:register-trap #xA01B :a0 hz))
  258.  
  259. (deftrap _compactmem ((cbneeded :signed-long))
  260.    (:d0 :signed-long)
  261.    (:register-trap #xA04C :d0 cbneeded))
  262.  
  263. (deftrap _purgemem ((cbneeded :signed-long))
  264.    nil
  265.    (:register-trap #xA04D :d0 cbneeded))
  266.  
  267. (deftrap _purgememsys ((cbneeded :signed-long))
  268.    nil
  269.    (:register-trap #xA44D :d0 cbneeded))
  270.  
  271. (deftrap _freemem () (:d0 :signed-long) (:register-trap 40988))
  272.  
  273.  
  274. (deftrap _resrvmem ((cbneeded :signed-long))
  275.    nil
  276.    (:register-trap #xA040 :d0 cbneeded))
  277.  
  278. (deftrap _reservemem ((cbneeded :signed-long))
  279.    nil
  280.    (:register-trap #xA040 :d0 cbneeded))
  281.  
  282. (deftrap _reservememsys ((cbneeded :signed-long))
  283.    nil
  284.    (:register-trap #xA440 :d0 cbneeded))
  285.  
  286. ; Note: GROW will always be set to 0 when this is called from MCL.
  287. (deftrap _maxmem ((grow (:pointer :signed-long)))
  288.   (:no-trap :long)
  289.   (:no-trap
  290.    (ccl:%stack-block ((ret 8))
  291.      (ccl:%gen-trap 41245 :return-block ret '(:a0 :d0))
  292.      (%put-long grow (%get-long ret))
  293.      (%get-long ret 4))))
  294.  
  295. (deftrap _setgrowzone ((growzone :pointer))
  296.    nil
  297.    (:register-trap #xA04B :a0 growzone))
  298.  
  299. (deftrap _setappllimit ((zonelimit :pointer))
  300.    nil
  301.    (:register-trap #xA02D :a0 zonelimit))
  302.  
  303. (deftrap _movehhi ((h :handle))
  304.    nil
  305.    (:register-trap #xA064 :a0 h))
  306.  
  307. (deftrap _disposptr ((p :pointer))
  308.    nil
  309.    (:register-trap #xA01F :a0 p))
  310.  
  311. (deftrap _disposeptr ((p :pointer))
  312.    nil
  313.    (:register-trap #xA01F :a0 p))
  314.  
  315. (deftrap _getptrsize ((p :pointer))
  316.    (:d0 :signed-long)
  317.    (:register-trap #xA021 :a0 p))
  318.  
  319. (deftrap _setptrsize ((p :pointer) (newsize :signed-long))
  320.    nil
  321.    (:register-trap #xA020 :a0 p :d0 newsize))
  322. (deftrap _disposhandle ((h :handle))
  323.    nil
  324.    (:register-trap #xA023 :a0 h))
  325.  
  326. (deftrap _disposehandle ((h :handle))
  327.    nil
  328.    (:register-trap #xA023 :a0 h))
  329.  
  330. (deftrap _gethandlesize ((h :handle))
  331.    (:d0 :signed-long)
  332.    (:register-trap #xA025 :a0 h))
  333. (deftrap _sethandlesize ((h :handle) (newsize :signed-long))
  334.    nil
  335.    (:register-trap #xA024 :a0 h :d0 newsize))
  336. (deftrap _emptyhandle ((h :handle))
  337.    nil
  338.    (:register-trap #xA02B :a0 h))
  339.  
  340. ; Warning. Assuming that (logicalsize long word) matches (bytecount :signed-long) in trap reallochandle
  341. (deftrap _reallochandle ((h :handle) (bytecount :signed-long))
  342.    nil
  343.    (:register-trap #xA027 :a0 h :d0 bytecount))
  344. (DEFTRAP _REALLOCATEHANDLE ((H :HANDLE) (BYTECOUNT :SIGNED-LONG))
  345.   NIL
  346.   (:REGISTER-TRAP #xA027 :A0 H :D0 BYTECOUNT))
  347. (deftrap _hsetrbit ((h :handle))
  348.    nil
  349.    (:register-trap #xA067 :a0 h))
  350.  
  351. (deftrap _hclrrbit ((h :handle))
  352.    nil
  353.    (:register-trap #xA068 :a0 h))
  354.  
  355. (deftrap _moremasters nil
  356.    nil
  357.    (:stack-trap #xA036))
  358.  
  359. (deftrap _blockmove ((srcptr :pointer) (destptr :pointer) (bytecount :signed-long))
  360.    nil
  361.    (:register-trap #xA02E :a0 srcptr :a1 destptr :d0 bytecount))
  362. (deftrap _memerror nil
  363.    (:no-trap :signed-integer)
  364.    (:no-trap (%get-signed-word (%int-to-ptr 544))))
  365.  
  366. ; Warning. Register trap purgespace returns multiple values: ((:a0 (contig long word)) (:d0 (total long word)))
  367. (DEFTRAP _PURGESPACE ((TOTAL (:POINTER :SIGNED-LONG))
  368.                       (CONTIG (:POINTER :SIGNED-LONG)))
  369.   ((:A0 :SIGNED-LONG) (:D0 :SIGNED-LONG))
  370.   (MULTIPLE-VALUE-BIND (TOTAL-VALUE CONTIG-VALUE) (:REGISTER-TRAP 41314)
  371.     (%PUT-LONG TOTAL TOTAL-VALUE)
  372.     (%PUT-LONG CONTIG CONTIG-VALUE)))
  373.  
  374. (deftrap _hgetstate ((h :handle))
  375.    (:d0 :signed-byte)
  376.    (:register-trap #xA069 :a0 h))
  377. (deftrap _hsetstate ((h :handle) (flags :signed-byte))
  378.    nil
  379.    (:register-trap #xA06A :a0 h :d0 flags))
  380. (deftrap _setapplbase ((startptr :pointer))
  381.    nil
  382.    (:register-trap #xA057 :a0 startptr))
  383.  
  384. (deftrap _maxapplzone nil
  385.    nil
  386.    (:stack-trap #xA063))
  387.  
  388. (deftrap _holdmemory ((address :pointer) (count :signed-long))
  389.    (:d0 :signed-integer)
  390.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 0))
  391.  
  392. (deftrap _unholdmemory ((address :pointer) (count :signed-long))
  393.    (:d0 :signed-integer)
  394.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 1))
  395.  
  396. (deftrap _lockmemory ((address :pointer) (count :signed-long))
  397.    (:d0 :signed-integer)
  398.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 2))
  399.  
  400. (deftrap _lockmemorycontiguous ((address :pointer) (count :signed-long))
  401.    (:d0 :signed-integer)
  402.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 4))
  403.  
  404. (deftrap _unlockmemory ((address :pointer) (count :signed-long))
  405.    (:d0 :signed-integer)
  406.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 3))
  407.  
  408. (deftrap _getphysical ((addresses (:pointer :logicaltophysicaltable)) 
  409.                        (physicalentrycount (:pointer :signed-long)))
  410.    (:no-trap :signed-integer)
  411.    (:no-trap (ccl::%stack-block ((ret 8))
  412.                (ccl::%gen-trap #xA15C :return-block ret 
  413.                       :d0 5 
  414.                       :a1 (%get-ptr physicalentrycount) 
  415.                       :a0 addresses 
  416.                       '(:d0 :a0))
  417.                (%put-ptr physicalentrycount (%get-ptr ret 4))
  418.                (%get-word ret 2))))
  419.  
  420. (deftrap _deferuserfn ((userfunction :pointer) (argument :pointer))
  421.    (:d0 :signed-integer)
  422.    (:register-trap #xA08F :a0 userfunction :d0 (ccl::%ptr-to-int argument)))
  423.  
  424. (deftrap _debuggergetmax nil
  425.    (:d0 :signed-long)
  426.    (:register-trap #xA08D :d0 0))
  427.  
  428. (deftrap _debuggerenter nil
  429.    nil
  430.    (:register-trap #xA08D :d0 1))
  431.  
  432.  
  433. (deftrap _debuggerexit nil
  434.    nil
  435.    (:register-trap #xA08D :d0 2))
  436.  
  437. (deftrap _debuggerpoll nil
  438.    nil
  439.    (:register-trap #xA08D :d0 3))
  440.  
  441. (deftrap _getpagestate ((address :pointer))
  442.    (:d0 :signed-integer)
  443.    (:register-trap #xA08D :a0 address :d0 4))
  444.  
  445. (deftrap _pagefaultfatal nil
  446.    (:d0 :boolean)
  447.    (:register-trap #xA08D :d0 5))
  448.  
  449. (deftrap _debuggerlockmemory ((address :pointer) (count :signed-long))
  450.    (:d0 :signed-integer)
  451.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 6))
  452.  
  453. (deftrap _debuggerunlockmemory ((address :pointer) (count :signed-long))
  454.    (:stack :signed-integer)
  455.    (:register-trap #xA08D :a0 address :a1 (%int-to-ptr count) :d0 7))
  456.  
  457. (deftrap _entersupervisormode nil
  458.    (:d0 :signed-integer)
  459.    (:register-trap #xA08D :d0 8))
  460.  
  461.  
  462. ; $ENDC                         ;  UsingMemory 
  463.  
  464. ; $IFC NOT UsingIncludes
  465.  
  466. ; $ENDC
  467.  
  468.  
  469. (export '($knotpaged $kpageondisk $kpageinmemory $defaultphysicalentrycount
  470.           $maxsize))
  471. (provide-interface 'MEMORY)
  472.